home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / AutoLoader.pm < prev    next >
Encoding:
Perl POD Document  |  2008-07-24  |  5.5 KB  |  212 lines
  1. package AutoLoader;
  2.  
  3. use strict;
  4. use 5.006_001;
  5.  
  6. our($VERSION, $AUTOLOAD);
  7.  
  8. my $is_dosish;
  9. my $is_epoc;
  10. my $is_vms;
  11. my $is_macos;
  12.  
  13. BEGIN {
  14.     $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare';
  15.     $is_epoc = $^O eq 'epoc';
  16.     $is_vms = $^O eq 'VMS';
  17.     $is_macos = $^O eq 'MacOS';
  18.     $VERSION = '5.63';
  19. }
  20.  
  21. AUTOLOAD {
  22.     my $sub = $AUTOLOAD;
  23.     my $filename = AutoLoader::find_filename( $sub );
  24.  
  25.     my $save = $@;
  26.     local $!; # Do not munge the value. 
  27.     eval { local $SIG{__DIE__}; require $filename };
  28.     if ($@) {
  29.     if (substr($sub,-9) eq '::DESTROY') {
  30.         no strict 'refs';
  31.         *$sub = sub {};
  32.         $@ = undef;
  33.     } elsif ($@ =~ /^Can't locate/) {
  34.         # The load might just have failed because the filename was too
  35.         # long for some old SVR3 systems which treat long names as errors.
  36.         # If we can successfully truncate a long name then it's worth a go.
  37.         # There is a slight risk that we could pick up the wrong file here
  38.         # but autosplit should have warned about that when splitting.
  39.         if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
  40.         eval { local $SIG{__DIE__}; require $filename };
  41.         }
  42.     }
  43.     if ($@){
  44.         $@ =~ s/ at .*\n//;
  45.         my $error = $@;
  46.         require Carp;
  47.         Carp::croak($error);
  48.     }
  49.     }
  50.     $@ = $save;
  51.     goto &$sub;
  52. }
  53.  
  54. sub can {
  55.     my ($self, $method) = @_;
  56.  
  57.     my $parent          = $self->SUPER::can( $method );
  58.     return $parent if $parent;
  59.  
  60.     my $package         = ref( $self ) || $self;
  61.     my $filename        = AutoLoader::find_filename( $package . '::' . $method );
  62.     local $@;
  63.     return unless eval { require $filename };
  64.  
  65.     no strict 'refs';
  66.     return \&{ $package . '::' . $method };
  67. }
  68.  
  69. sub find_filename {
  70.     my $sub = shift;
  71.     my $filename;
  72.     # Braces used to preserve $1 et al.
  73.     {
  74.     # Try to find the autoloaded file from the package-qualified
  75.     # name of the sub. e.g., if the sub needed is
  76.     # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is
  77.     # something like '/usr/lib/perl5/Getopt/Long.pm', and the
  78.     # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'.
  79.     #
  80.     # However, if @INC is a relative path, this might not work.  If,
  81.     # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is
  82.     # 'lib/Getopt/Long.pm', and we want to require
  83.     # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib').
  84.     # In this case, we simple prepend the 'auto/' and let the
  85.     # C<require> take care of the searching for us.
  86.  
  87.     my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/);
  88.     $pkg =~ s#::#/#g;
  89.     if (defined($filename = $INC{"$pkg.pm"})) {
  90.         if ($is_macos) {
  91.         $pkg =~ tr#/#:#;
  92.         $filename = undef
  93.           unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s;
  94.         } else {
  95.         $filename = undef
  96.           unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s;
  97.         }
  98.  
  99.         # if the file exists, then make sure that it is a
  100.         # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al',
  101.         # or './lib/auto/foo/bar.al'.  This avoids C<require> searching
  102.         # (and failing) to find the 'lib/auto/foo/bar.al' because it
  103.         # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib').
  104.  
  105.         if (defined $filename and -r $filename) {
  106.         unless ($filename =~ m|^/|s) {
  107.             if ($is_dosish) {
  108.             unless ($filename =~ m{^([a-z]:)?[\\/]}is) {
  109.                 if ($^O ne 'NetWare') {
  110.                 $filename = "./$filename";
  111.                 } else {
  112.                 $filename = "$filename";
  113.                 }
  114.             }
  115.             }
  116.             elsif ($is_epoc) {
  117.             unless ($filename =~ m{^([a-z?]:)?[\\/]}is) {
  118.                  $filename = "./$filename";
  119.             }
  120.             }
  121.             elsif ($is_vms) {
  122.             # XXX todo by VMSmiths
  123.             $filename = "./$filename";
  124.             }
  125.             elsif (!$is_macos) {
  126.             $filename = "./$filename";
  127.             }
  128.         }
  129.         }
  130.         else {
  131.         $filename = undef;
  132.         }
  133.     }
  134.     unless (defined $filename) {
  135.         # let C<require> do the searching
  136.         $filename = "auto/$sub.al";
  137.         $filename =~ s#::#/#g;
  138.     }
  139.     }
  140.     return $filename;
  141. }
  142.  
  143. sub import {
  144.     my $pkg = shift;
  145.     my $callpkg = caller;
  146.  
  147.     #
  148.     # Export symbols, but not by accident of inheritance.
  149.     #
  150.  
  151.     if ($pkg eq 'AutoLoader') {
  152.     if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) {
  153.         no strict 'refs';
  154.         *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD;
  155.         *{ $callpkg . '::can'      } = \&can;
  156.     }
  157.     }
  158.  
  159.     #
  160.     # Try to find the autosplit index file.  Eg., if the call package
  161.     # is POSIX, then $INC{POSIX.pm} is something like
  162.     # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
  163.     # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that.
  164.     #
  165.     # However, if @INC is a relative path, this might not work.  If,
  166.     # for example, @INC = ('lib'), then
  167.     # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
  168.     # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
  169.     #
  170.  
  171.     (my $calldir = $callpkg) =~ s#::#/#g;
  172.     my $path = $INC{$calldir . '.pm'};
  173.     if (defined($path)) {
  174.     # Try absolute path name.
  175.     if ($is_macos) {
  176.         (my $malldir = $calldir) =~ tr#/#:#;
  177.         $path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s;
  178.     } else {
  179.         $path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#;
  180.     }
  181.  
  182.     eval { require $path; };
  183.     # If that failed, try relative path with normal @INC searching.
  184.     if ($@) {
  185.         $path ="auto/$calldir/autosplit.ix";
  186.         eval { require $path; };
  187.     }
  188.     if ($@) {
  189.         my $error = $@;
  190.         require Carp;
  191.         Carp::carp($error);
  192.     }
  193.     } 
  194. }
  195.  
  196. sub unimport {
  197.     my $callpkg = caller;
  198.  
  199.     no strict 'refs';
  200.  
  201.     for my $exported (qw( AUTOLOAD can )) {
  202.     my $symname = $callpkg . '::' . $exported;
  203.     undef *{ $symname } if \&{ $symname } == \&{ $exported };
  204.     *{ $symname } = \&{ $symname };
  205.     }
  206. }
  207.  
  208. 1;
  209.  
  210. __END__
  211.  
  212.